home *** CD-ROM | disk | FTP | other *** search
/ Business Assistant / Business Assistant.iso / home / willrt / intro.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-04-11  |  7.9 KB  |  212 lines
  1. 1  REM INTRO 4/11/86
  2. 10  CLEAR ,49152:AML=49152:KEY OFF:GOSUB 12000:ON ERROR GOTO 9900
  3. 12  FOR I=1 TO 10:KEY I,"":NEXT:KEY 1,CHR$(1):KEY 2,CHR$(2):KEY 3,CHR$(3)
  4. 14  CO1=7:CO2=0:CO3=0:COH=7:COB=7:LOCATE ,,0:SHIFT=18:SC2$=CHR$(222):SC1$=CHR$(178)
  5. 20  CLS:PRINT"W":DEF SEG=&HB800:N1=PEEK(0):DEF SEG
  6. 22  CLS:PRINT"Q":DEF SEG=&HB800:N2=PEEK(0):DEF SEG
  7. 24  ICRT=0:IF N1=87 AND N2=81 THEN ICRT=1
  8. 26  SHI=SHIFT:IF ICRT>0 THEN CO1=15:CO2=0:CO3=8:COB=9:COH=14:SHI=0:SHIFT=0
  9. 30  GOSUB 4870:IF ICRT >0 THEN WIDTH 40
  10. 32  IF ICRT < 1 THEN WIDTH 80
  11. 40  GOTO 10000
  12. 50  I1%=1:I2%=NT%
  13. 100  FOR IS=I1% TO I2%:REM MAIN LOOP
  14. 120  S=IS-TH%
  15. 170  BK%=0:GOSUB 5000
  16. 180  IF BK%<1 THEN GOTO  220
  17. 190  I1%=IS-1:IF I1%<TH%+1 THEN I1%=TH%+1:GOSUB 1800
  18. 200  IS=NT%:GOTO 230
  19. 220  IF IS=NT% OR (S=A1 AND I$=N$) THEN GOTO 2200
  20. 230  NEXT IS
  21. 240  GOTO 100
  22. 250  END
  23. 1100  GOSUB 1300:POKE AML,LB:POKE AML+1,HB
  24. 1110  POKE AML+2,0:POKE AML+3,&HB0:IF AMID>0 THEN POKE AML+3,&HB8
  25. 1120  POKE AML+4,AMID:RETURN
  26. 1300  HB=INT(ANUM/256):LB=ANUM-HB*256:RETURN
  27. 1600  I$=X$
  28. 1601  V=22:H=19:IF S=A1 THEN V=14:H=37
  29. 1602  IF F2%=2 THEN V=16:H=18
  30. 1603  GOSUB 4800:IF A>10 THEN PRINT I$;
  31. 1604  T$=INKEY$:IF T$ = X$ THEN 1604
  32. 1605  A=ASC(T$):IF A>90 THEN T$=CHR$(A-32):A=A-32
  33. 1606  IF A<32 THEN 1660
  34. 1607  IF S=A2 AND T$=H$ THEN 1610
  35. 1609  I$=T$:GOTO 1601
  36. 1610  IF I$=X$ THEN I$=T$
  37. 1611  V%=VAL(I$):IF F2%=1 OR F2%=2 THEN GOTO 1695
  38. 1613  IF S<>A2 THEN 1620
  39. 1616  IF I$=H$ THEN RETURN
  40. 1618  IF HF%<1 THEN 1690
  41. 1620  IF S<> A1 THEN 1628
  42. 1622  IF I$=Y$ OR I$=N$ OR I$=B$ OR I$=Q$ THEN 1695
  43. 1624  GOSUB 1680:GOTO 1690
  44. 1628  IF S=1 AND (I$=SP$ OR I$=CR$) THEN 1695
  45. 1630  IF S>1 AND (I$=SP$ OR I$=CR$ OR I$=B$ OR I$=Q$) THEN 1695
  46. 1640  GOSUB 1800:GOSUB 1680:GOTO 1600
  47. 1650  LOCATE ,,0:H=19:GOSUB 4800
  48. 1652  I$=INKEY$:IF I$=X$ THEN 1652
  49. 1654  IF I$=CR$ OR I$=SP$ OR I$=ES$ THEN RETURN
  50. 1658  GOSUB 1800:GOTO 1650
  51. 1660  IF A<>0 THEN 1670:REM CHECK EXT ASCII
  52. 1662  AA=ASC(MID$(T$,2,1)):IF AA=75 OR AA=83 THEN A=8:GOTO 1672
  53. 1664  T$="":GOTO 1610:REM OTHER EXTENDED CODES
  54. 1670  IF A=13 OR A=27 THEN 1610:REM RETURN/ESC
  55. 1672  IF A=8 THEN GOSUB 1680:GOTO 1600
  56. 1674  IF (A=1 AND S>1) OR A=2 OR (A=3 AND S=A2) THEN I$=CHR$(A):RETURN
  57. 1678  GOTO 1690
  58. 1680  IF I$<>CR$ THEN V=CSRLIN:H=POS(1)-1:PRINT"-";:LOCATE V,H
  59. 1682  PRINT SP$;:RETURN
  60. 1690  GOSUB 1800:GOTO 1600
  61. 1695  RETURN
  62. 1700  DEF SEG = 0:POKE 1050,PEEK(1052):DEF SEG:RETURN:REM RESET STROBE
  63. 1800  SOUND 440,5:RETURN
  64. 1965   BEEP:RETURN:REM UNUSED?
  65. 2200  GOSUB 4900:V=10:H=5:GOSUB 4800:PRINT "PLEASE WAIT: DISK DRIVE IN USE...":REM GO ON
  66. 2210  V=1:H=5:GOSUB 4800:PRINT "   ...GOING TO NEXT PHASE   "
  67. 2220  RUN "MAIN"
  68. 2222  END
  69. 2400  GOSUB 4900:REM QUIT
  70. 2404  V=1:H=6:GOSUB 4800:PRINT "      ....QUITTING"; SPC( 10)
  71. 2420  V=10:H=2:GOSUB 4800:PRINT "TYPE "DQ$"Y"DQ$" IF YOU REALLY WANT TO QUIT"
  72. 2430  V=12:H=3:GOSUB 4800:PRINT "TYPE "DQ$"C"DQ$" TO CONTINUE THE PROGRAM"
  73. 2432  V=14:H=9:GOSUB 4800:PRINT "(DON'T FORGET "DQ$"RETURN"DQ$")"
  74. 2440  F2%=2:GOSUB 1600:IF I$=C$ THEN I$=X$:RETURN
  75. 2450  IF I$=Y$ THEN CLS:V=10:H=13:GOSUB 4800:PRINT "SO LONG... "CHR$(2):END
  76. 2460  GOSUB 1800:GOTO 2440
  77. 3000  HF%=1:IF ICRT<1 AND F0%<1 THEN SHI=0:GOSUB 31000
  78. 3010  F0%=0:GOTO 3080
  79. 3030  PP=A0+2*GH%:GOTO 3230
  80. 3080  INF=1:GOSUB 3900
  81. 3182  GOSUB 4870:F1%=1:GOSUB 4000
  82. 3202  F2%=1:GOSUB 1600:F0%=1:IF I$=CR$ OR I$=SP$ OR I$=ES$ THEN F0%=0:SHI=SHIFT:GOTO 3232
  83. 3204  IF V%<1 OR V%>H% THEN GOSUB 1800:GOTO 3202
  84. 3220  IF ICRT<1 THEN SHI=39
  85. 3222  NN%=NS%(V%):PP=A0+2*NN%
  86. 3230  ALO=PP:GOSUB 3910:HP=ANUM:GOSUB 3400:GOSUB 1650:IF I$=ES$ THEN F0%=0:SHI=SHIFT
  87. 3232  CLS:RETURN
  88. 3400  AHEL=63000:BLOAD"NHELPB."+MID$(STR$(NN%),2),AHEL
  89. 3402  FO%=2:NH1=PEEK(AHEL+1):LHED1=6+5*NH1:ANUM=AHEL+LHED1:GOSUB 1100
  90. 3404  GOSUB 30000
  91. 3405  CALL DECOMP:GOSUB 31000
  92. 3410  V=1:H=5:GOSUB 4800:PRINT "DEFINITION:":V=3:H=3:GOSUB 4800:PRINT "..."
  93. 3480  F0%=1:F1%=2:GOSUB 4000:RETURN
  94. 3600  AP=A0+2*IS:AH=PEEK(AP)+256*PEEK(AP+1):H%=PEEK(AH):IF H%<1 THEN 3680
  95. 3640  FOR I=1 TO H%:AB=AH+5*I-2:XT%(I)=PEEK(AB):YT%(I)=PEEK(AB+1):XB%(I)=PEEK(AB+2):YB%(I)=PEEK(AB+3):NS%(I)=PEEK(AB+4):NEXT I
  96. 3680  N%=PEEK(AH+1):IV%=PEEK(AH+2):AS=AH+3+5*H%
  97. 3690  RETURN
  98. 3900  FOR I=1 TO H%:VV1=YT%(I):HH1=XT%(I):VV2=YB%(I):HH2=XB%(I):IF HH1<=1 THEN HH1=2
  99. 3901  GOSUB 4870:IF INF>0 THEN GOSUB 4860
  100. 3902  FOR JJ=VV1 TO VV2:FOR II=HH1 TO HH2:V=JJ:H=II:GOSUB 4800:PRINT CHR$(SCREEN(JJ,II+SHI));:NEXT II:NEXT JJ
  101. 3905  V=VV1:H=HH1:GOSUB 4800:IF INF<1 THEN 3908
  102. 3906  GOSUB 4890:IF ICRT<1 THEN GOSUB 4860
  103. 3907  PRINT MID$(STR$(I),2,1):GOTO 3909
  104. 3908  PRINT SPC(1);
  105. 3909  NEXT I:GOSUB 4870:RETURN
  106. 3910  ANUM=PEEK(ALO)+256*PEEK(ALO+1):RETURN
  107. 4000  GOSUB 4880
  108. 4020  V=22:H=2:GOSUB 4800
  109. 4040  PRINT UL$;
  110. 4070  V=23:H=4:GOSUB 4800
  111. 4081  IF S=A1 THEN PRINT " TYPE "DQ$Y$DQ$" OR "DQ$N$DQ$"--AND THEN "DQ$"RETURN"DQ$;:GOTO 4160
  112. 4082  IF S<>A2 THEN 4090
  113. 4084  IF F1%<1 AND HF%<1 THEN PRINT "  PRESS "DQ$"F3"DQ$" TO TRY DEFINITIONS";:GOTO 4160
  114. 4085  IF F1%<1 THEN H=H-2:GOSUB 4800:PRINT "PRESS "RT$" FOR NEXT SCREEN  F3=DEF";:GOTO 4160
  115. 4086  IF F1%=1 THEN H=H-2:GOSUB 4800:PRINT "   TYPE NUMBER NEXT TO ITEM YOU WANT  ";:GOTO 4160
  116. 4088  IF F1%=2 THEN H=3:GOSUB 4800:PRINT J$RT$" IF YOU WANT MORE DEF'S";:GOTO 4160
  117. 4090  IF I$=Q$ THEN PRINT SPC( 35);:GOTO 4160
  118. 4100  PRINT "PRESS "RT$" TO GO TO NEXT SCREEN";
  119. 4160  V=24:H=3:GOSUB 4800
  120. 4190  IF S=1 OR I$=Q$ THEN PRINT SPC( 35);:GOTO 4230
  121. 4200  IF F1%=0 AND (S<>A2 OR HF%>0) THEN PRINT "      <F1=BACK UP   F2=QUIT>       ";
  122. 4202  IF F1%=1 THEN PRINT "(PRESS "RT$" TO LEAVE DEFINITION)";
  123. 4204  IF F1%=2 THEN PRINT J$DQ$"ESC"DQ$"    IF YOU DON'T";
  124. 4230  TS=S:IF S>10 THEN TS=TS-1
  125. 4231  TS$=STR$(TS):IF LEFT$(TS$,1)=" " THEN TS$=MID$(TS$,2,2)
  126. 4232  IF S=10 THEN TS$="9+"
  127. 4234  V=22:H=39:IF F0%>0 THEN TS$="D"+TS$:H=H-1
  128. 4236  IF S=10 THEN H=H-1
  129. 4238  GOSUB 4800:GOSUB 4865:PRINT TS$;:GOSUB 4870:RETURN
  130. 4700   GOSUB 4900:V = 10:H = 3: GOSUB 4800: PRINT "PLEASE WAIT: DISK DRIVE IN USE...": RETURN 
  131. 4800  LOCATE V,H+SHI:RETURN:REM HTAB,VTAB
  132. 4810  LOCATE V,POS(1):RETURN:REM VTAB
  133. 4820  LOCATE CSRLIN,H+SHI:RETURN:REM HTAB
  134. 4855  GOSUB 4860:IF ICRT>0 THEN COLOR COH,CO2,CO3
  135. 4856  RETURN
  136. 4860  COLOR CO2,COB,CO3:RETURN:REM INV
  137. 4865  GOSUB 4860:IF ICRT>0 THEN COLOR COB,CO2,CO3
  138. 4866  RETURN
  139. 4870  COLOR CO1,CO2,CO3:RETURN:REM NORM
  140. 4880  COLOR COH,CO2,CO3:IF ICRT>0 AND HFL>0 THEN COLOR COH,CO1,CO3
  141. 4882  RETURN
  142. 4890  COLOR COH,0,CO3:RETURN
  143. 4900  CLS:RETURN
  144. 5000  GOSUB 3600:SHI=SHIFT:IF F0%>0 THEN SHI=0
  145. 5030  ANUM=AS:GOSUB 1100:GOSUB 30000
  146. 5040  CALL DECOMP
  147. 5045  GOSUB 31000
  148. 5050  F1%=0:GOSUB 4000
  149. 5070  IF F0%>0 THEN GOSUB 3000:GOTO 5000
  150. 5120  IF S=1 THEN GOSUB 1700:GOSUB 1650:GOTO 5200
  151. 5130  F2%=0:GOSUB 1700:GOSUB 1600
  152. 5200  IF I$=CHR$(2) OR I$=Q$ THEN GOSUB 2400:GOTO 5000
  153. 5210  IF I$=CHR$(1) OR I$=B$ THEN BK%=1:I$=B$:RETURN
  154. 5212  IF H%>0 AND (I$=H$ OR I$=CHR$(3)) THEN GOSUB 3000:GOTO 5000
  155. 5220  RETURN
  156. 9900  ER=ERR
  157. 9901  GOSUB 4900:II=0:FOR IJ=1 TO N3:IF ER=ER%(IJ) THEN II=IJ:IJ=N3
  158. 9902  NEXT
  159. 9903  V=3:H=3:GOSUB 4800:PRINT"THE FOLLOWING ERROR HAS OCCURED:":V=V+2:GOSUB 4800:PRINT DQ$ER1$(II)DQ$
  160. 9904  V=CSRLIN+3:GOSUB 4800:IF II>0 THEN 9908
  161. 9906  PRINT"PLEASE REPORT ERROR "ER:V=V+1:H=3:GOSUB 4800:PRINT"AT LINE "ERL" IN PROGRAM "DQ$"INTRO"DQ$:V=V+1:GOSUB 4800:PRINT"TO NOLO PRESS (415-549-1976).":V=V+2:GOSUB 4800:PRINT"PRESS ANY KEY TO END":GOTO 9930
  162. 9908  PRINT"PLEASE CHECK...":V=V+1:H=3:GOSUB 4800:PRINT ER2$(II):V=V+1:GOSUB 4800:PRINT ER3$(II)
  163. 9910  V=CSRLIN+3:GOSUB 4800:PRINT"THEN EITHER RERUN THE PROGRAM OR":V=V+2:GOSUB 4800:PRINT "PRESS ANY KEY TO RESUME"
  164. 9930  I$=INKEY$:IF I$=X$ THEN 9930
  165. 9940  IF II>0 THEN CLS:RESUME
  166. 9949  SYSTEM
  167. 10000  CLS:BLOAD "DECOM.BIN",AML:DECOMP=AML+6:ES$=CHR$ (27)
  168. 10060  CH$="+":HY$="-":X$="":H$="?":Q$="Q":P$="P":B$="B":Y$="Y":N$="N":C$="C":S$="S":SP$=" ":CR$=CHR$(13):DQ$=CHR$(34):RT$=DQ$+"RETURN"+DQ$:ES$=CHR$(27)
  169. 10070  A1=6:A2=8:A3=7:A4=2:REM INST?,DEF,ENTER,UPDATE
  170. 10112  A0=49152+5*256:BLOAD "MASTER.INT",A0
  171. 10130  NT%=PEEK(A0):TH%=PEEK(A0+1)
  172. 10140  NM%=12:DIM M$(NM%):DATA "9","","4","6","2","14","14","14","14","14","14","14": FOR I=1 TO NM%:READ M$(I):NEXT I
  173. 10180  PS$="        "
  174. 10280  F1$="  SEE MANUAL PART "
  175. 10290  F2$="   LEGISOFT/NOLO PRESS   "
  176. 10295  UL$="--------------------------------------":J$="PRESS "
  177. 10300  T$=X$:FOR I=1 TO 240:T$=T$+Y$:NEXT:ST1$=T$:ST2$=T$:ST3$=T$:ST4$=T$:GOTO 50
  178. 12000  DQ$=CHR$(34):N3=11:DIM ER1$(N3),ER2$(N3),ER3$(N3),ER%(N3)
  179. 12002  ER1$(0)="PROGRAM (OR UNIDENTIFIABLE) ERROR"
  180. 12010  ER%(1)=7:ER1$(1)="OUT OF MEMORY":ER2$(1)="YOUR SYSTEM MEMORY; 128K RAM IS":ER3$(1)="REQUIRED (SOME COMPATIBLES NEED 256K)"
  181. 12020  ER%(2)=25:ER1$(2)="DEVICE FAULT":ER2$(2)="YOUR HARDWARE/INTERFACE CONNECTIONS"
  182. 12030  ER%(3)=27:ER1$(3)="OUT OF PAPER":ER2$(3)="PAPER SUPPLY & PRINTER ON/OFF SWITCH"
  183. 12040  ER%(4)=53:ER1$(4)="FILE NOT FOUND":ER2$(4)="THAT THE WILLWRITER DISKETTE IS OK":ER3$(4)="AND STILL IN DRIVE."
  184. 12050  ER%(5)=57:ER1$(5)="DEVICE I/O ERROR":ER2$(5)="DISK DRIVE AND PRINTER CONNECTIONS"
  185. 12060  ER%(6)=61:ER1$(6)="DISK FULL":ER2$(6)="THAT WW DISKETTE IS IN DRIVE, AND":ER3$(6)="THAT NO FILES HAVE BEEN ADDED TO IT"
  186. 12070  ER%(7)=67:ER1$(7)="TOO MANY FILES":ER2$(7)="THAT WW DISKETTE IS IN DRIVE, AND":ER3$(7)="THAT NO FILES HAVE BEEN ADDED TO IT"
  187. 12080  ER%(8)=68:ER1$(8)="DEVICE UNAVAILABLE":ER2$(8)="DISK DRIVE"
  188. 12090  ER%(9)=70:ER1$(9)="DISK WRITE PROTECT":ER2$(9)="DISKETTE FOR A WRITE PROTECT TAB.":ER3$(9)="(PROGRAM WON'T WORK ONE IN PLACE)"
  189. 12100  ER%(10)=71:ER1$(10)="DISK NOT READY":ER2$(10)="THAT DISKETTE IS IN DRIVE AND THAT":ER3$(10)="THE DISK DRIVE DOOR IS CLOSED"
  190. 12110  ER%(11)=72:ER1$(11)="DISK MEDIA ERROR":ER2$(11)="DISKETTE FOR IMPERFECTIONS"
  191. 12999  RETURN
  192. 30000  AD1=VARPTR(ST1$):AD2=VARPTR(ST2$):AD3=VARPTR(ST3$):AD4=VARPTR(ST4$)
  193. 30010  POKE &HC082,PEEK(AD1+1):POKE &HC083,PEEK(AD1+2)
  194. 30020  POKE &HC084,PEEK(AD2+1):POKE &HC085,PEEK(AD2+2)
  195. 30030  POKE &HC086,PEEK(AD3+1):POKE &HC087,PEEK(AD3+2)
  196. 30040  POKE &HC088,PEEK(AD4+1):POKE &HC089,PEEK(AD4+2):RETURN
  197. 31000  H=1:V=1:GOSUB 4800:M$=F2$:IF S<>A4 THEN M$=F1$+M$(S)+PS$
  198. 31001  IF F0%>1 AND ICRT<1 THEN M$=STRING$(25,SC1$)
  199. 31002  I=0:IF S<>A4 AND LEN(M$(S))>4 THEN M$=MID$(M$,2,25)
  200. 31008  IF F0%<1 OR ICRT>0 THEN CLS
  201. 31010  II=0:TT$=ST1$:GOSUB 31050:TT$=ST2$:GOSUB 31050:TT$=ST3$:GOSUB 31050
  202. 31020  JF=1:TT$=ST4$:GOSUB 31050:RETURN
  203. 31050  FOR I=1 TO 6:GOSUB 31290:PRINT MID$(TT$,40*I-38,38);:GOSUB 31300
  204. 31052  NEXT:RETURN
  205. 31290  II=II+1:GOSUB 4820:REM PRINT LEFT BORDER
  206. 31292  GOSUB 4855:PRINT MID$(M$,II,1);:IF II=1 AND ICRT>0 THEN GOSUB 4880:RETURN
  207. 31298  GOSUB 4870:RETURN
  208. 31300  GOSUB 4870
  209. 31302  IF ICRT<1 AND II<>24 THEN PRINT SC2$;
  210. 31304  IF II<24 THEN PRINT
  211. 31310  RETURN
  212.